home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / dylan / string.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  4.6 KB  |  143 lines  |  [TEXT/ttxt]
  1. module: Dylan
  2. rcs-header: $Header: string.dylan,v 1.8 94/11/14 18:29:23 wlott Exp $
  3.  
  4. //======================================================================
  5. //
  6. // Copyright (c) 1994  Carnegie Mellon University
  7. // All rights reserved.
  8. // 
  9. // Use and copying of this software and preparation of derivative
  10. // works based on this software are permitted, including commercial
  11. // use, provided that the following conditions are observed:
  12. // 
  13. // 1. This copyright notice must be retained in full on any copies
  14. //    and on appropriate parts of any derivative works.
  15. // 2. Documentation (paper or online) accompanying any system that
  16. //    incorporates this software, or any part of it, must acknowledge
  17. //    the contribution of the Gwydion Project at Carnegie Mellon
  18. //    University.
  19. // 
  20. // This software is made available "as is".  Neither the authors nor
  21. // Carnegie Mellon University make any warranty about the software,
  22. // its performance, or its conformity to any specification.
  23. // 
  24. // Bug reports, questions, comments, and suggestions should be sent by
  25. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  26. //
  27. //======================================================================
  28. //
  29. //  This file contains the support for strings that isn't built in.
  30. //
  31.  
  32. // By adding this method, we insure that the one which follows isn't
  33. // erroneously applied to things which are already strings.
  34. //
  35. define method as (clas == <string>, collection :: <string>)
  36.   collection;
  37. end method as;
  38.  
  39. define method as (clas == <string>, collection :: <collection>)
  40.   as(<byte-string>, collection)
  41. end as;
  42.  
  43. define method \< (string1 :: <string>, string2 :: <string>)
  44.   block (return)
  45.     let (init, limit, next, done?, key, elem) =
  46.        forward-iteration-protocol(string2);
  47.     for (char1 in string1,
  48.      state = init then next(string2, state),
  49.      until done?(string2, state, limit))
  50.       let char2 = elem(string2, state);
  51.       case
  52.     char1 < char2 => return(#t);
  53.     char1 > char2 => return(#f);
  54.      otherwise => #f;
  55.       end case
  56.     finally
  57.       if (done?(string2, state, limit)) #f else #t end
  58.     end for
  59.   end block
  60. end \<;
  61.  
  62. define method as-lowercase (string :: <string>)
  63.   map(as-lowercase, string)
  64. end as-lowercase;
  65.  
  66. define method as-uppercase (string :: <string>)
  67.   map(as-uppercase, string)
  68. end as-uppercase;
  69.  
  70. define method as-lowercase! (string :: <string>)
  71.   map-into(string, as-lowercase, string)
  72. end as-lowercase!;
  73.  
  74. define method as-uppercase! (string :: <string>)
  75.   map-into(string, as-uppercase, string)
  76. end as-uppercase!;
  77.  
  78. // Provide a type error rather than a no applicable methods error when
  79. // someone tries to put something illegal into a <string>
  80. //
  81. define method element-setter
  82.     (new, string :: <byte-string>, index :: <fixed-integer>)
  83.   error(make(<type-error>, value: new, type: <byte-character>));
  84. end;
  85.  
  86. define method element-setter 
  87.     (new, string :: <unicode-string>, index :: <fixed-integer>)
  88.   error(make(<type-error>, value: new, type: <character>));
  89. end;
  90.  
  91. define method copy-sequence
  92.     (vector :: <byte-string>, #key start = 0, end: last)
  93.   let src-sz = size(vector);
  94.   let last = if (last & last < src-sz) last else src-sz end if;
  95.   let sz = last - start;
  96.   let result = make(<byte-string>, size: sz);
  97.   copy-bytes(result, 0, vector, start, sz);
  98.   result;
  99. end method copy-sequence;
  100.  
  101. // Specialized method which takes advantage of "copy-bytes".  Yields ~15%
  102. // speedup for some apps.
  103. define method concatenate-as
  104.     (cls == <byte-string>, vector :: <byte-string>, #next next-method,
  105.      #rest more_vectors)
  106.   let vector-count = size(more_vectors);
  107.   case
  108.     vector-count == 0 =>
  109.       // We must check for this case
  110.       copy-sequence(vector);
  111.     vector-count == 1 =>
  112.       // We can get big wins in the common two-string case.
  113.       let second-vector = first(more_vectors);
  114.       if (instance?(second-vector, <byte-string>))
  115.     let size1 = size(vector);
  116.     let size2 = size(second-vector);
  117.       
  118.     let result = make(cls, size: size1 + size2);
  119.     copy-bytes(result, 0, vector, 0, size1);
  120.     copy-bytes(result, size1, second-vector, 0, size2);
  121.     result;
  122.       else
  123.     next-method();
  124.       end if;
  125.     (~subtype?(cls, <vector>)
  126.        | ~every?(rcurry(instance?, <byte-string>), more_vectors)) =>
  127.       next-method();
  128.     otherwise =>
  129.       let length = reduce(method (int, seq) int + size(seq) end method,
  130.               size(vector), more_vectors);
  131.       let result = make(cls, size: length);
  132.       for (next in more_vectors,
  133.        src = vector then next,
  134.        sz = size(vector) then size(next),
  135.        index = 0 then index + sz)
  136.     copy-bytes(result, index, src, 0, sz);
  137.       finally
  138.     copy-bytes(result, index, src, 0, sz);
  139.       end for;
  140.       result;
  141.   end case;
  142. end method concatenate-as;
  143.